home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyInterruptSafeDebug.p < prev    next >
Text File  |  1997-01-29  |  3KB  |  149 lines
  1. unit MyInterruptSafeDebug;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     procedure StartupInterruptSafeDebug;
  9.     procedure InterruptSafeDebug (const s: Str255);
  10.     procedure InterruptSafeDebugChar (ch: char);
  11.  
  12. implementation
  13.  
  14.     uses
  15.         Fonts,Quickdraw,Memory,Windows,MyLowLevel,MyTypes, MyMemory, MyStartup;
  16.  
  17.     const
  18.         debug = true;
  19.  
  20.     const
  21.         ourfont = geneva;
  22.         oursize = 9;
  23.         ourheight = 10;
  24.         ourdescent = 2;
  25.         max_pixelsize = 8;
  26.         ourrows = 12;
  27.         our_magic = $12435687;
  28.  
  29.     type
  30.         CharArray = packed array[char, 1..ourheight, 1..max_pixelsize] of Byte;
  31.  
  32.     const
  33.         WMgrPort = $9DE;
  34.  
  35.     type
  36.         GrafPtrPtr = ^GrafPtr;
  37.  
  38.     var
  39.         baseaddr: Ptr;
  40.         rowbytes: integer;
  41.         pixelsize: integer;
  42.         ourchars: ^CharArray;
  43.         pos, count: integer;
  44.         row: integer;
  45.         magic: longint;
  46.  
  47.     procedure InterruptSafeDebugChar (ch: char);
  48.         procedure Plot (ch: char);
  49.             var
  50.                 h, c: integer;
  51.         begin
  52.             for h := 1 to ourheight do begin
  53.                 for c := 1 to pixelsize do begin
  54.                     AddPtrLong(baseaddr, longint(h - 1 + row * ourheight) * rowbytes + pos * pixelsize + c - 1)^ := SignedByte(ourchars^[ch, h, c]);
  55.                 end;
  56.             end;
  57.         end;
  58.     begin
  59.         if debug then begin
  60.             if magic <> our_magic then begin
  61.                 DebugStr('BANG!');
  62.             end;
  63.             Plot(ch);
  64.             pos := (pos + 1) mod count;
  65.             if pos = 0 then begin
  66.                 row := (row + 1) mod ourrows;
  67.             end;
  68.             Plot('•');
  69.         end;
  70.     end;
  71.  
  72.     procedure InterruptSafeDebug (const s: Str255);
  73.         var
  74.             i: integer;
  75.     begin
  76.         if debug then begin
  77.             if s = '' then begin
  78.                 InterruptSafeDebugChar('*');
  79.             end else begin
  80.                 for i := 1 to length(s) do begin
  81.                     InterruptSafeDebugChar(s[i]);
  82.                 end;
  83.                 InterruptSafeDebugChar('.');
  84.             end;
  85.         end;
  86.     end;
  87.  
  88.     function InitInterruptSafeDebug(var msg: integer): OSStatus;
  89.         var
  90.             wp: WindowPtr;
  91.             r: Rect;
  92.             i, h, c: integer;
  93.             ch: char;
  94.             junk: OSErr;
  95.     begin
  96. {$unused(msg)}
  97. {        DebugStr( 'InitInterruptSafeDebug;g' );}
  98.         if debug then begin
  99.             magic := our_magic;
  100.             junk := MNewPtr(ourchars, SizeOf(CharArray));
  101.             SetRect(r, 0, 40, 100, 100);
  102.             wp := NewCWindow(nil, r, '', true, 0, POINTER(-1), false, 0);
  103.             SetPort(wp);
  104.             TextFont(ourfont);
  105.             TextSize(oursize);
  106.             baseaddr := CGrafPtr(wp)^.portPixMap^^.baseAddr;
  107.             pixelsize := CGrafPtr(wp)^.portPixMap^^.pixelSize;
  108.             rowbytes := BAND(CGrafPtr(wp)^.portPixMap^^.rowBytes, $3FFF);
  109.             r := GetQDGlobals^.screenBits.bounds;
  110.             for ch := chr(0) to chr(255) do begin
  111.                 SetRect(r, 0, 0, 100, 100);
  112.                 EraseRect(r);
  113.                 MoveTo(0, ourheight - ourdescent);
  114.                 DrawChar(ch);
  115.                 for h := 1 to ourheight do begin
  116.                     for c := 1 to pixelsize do begin
  117.                         ourchars^[ch, h, c] := BAND(AddPtrLong(baseaddr, longint(40 + h - 1) * rowbytes + c - 1)^, $FF);
  118.                     end;
  119.                 end;
  120.             end;
  121.             DisposeWindow(wp);
  122.             SetPort(GrafPtrPtr(WMgrPort)^);
  123.             r := GetQDGlobals^.screenBits.bounds;
  124.             OffsetPtr(baseaddr, longint(r.bottom - r.top - ourheight * ourrows) * rowbytes);
  125.             r.top := r.bottom - ourheight * ourrows;
  126.             EraseRect(r);
  127.             pos := 0;
  128.             row := 0;
  129.             count := (r.right - r.left) div 8 - 2;
  130.             for i := 1 to count * ourrows do begin
  131.                 InterruptSafeDebugChar(' ');
  132.             end;
  133.         end;
  134.         InitInterruptSafeDebug := noErr;
  135.     end;
  136.  
  137.     procedure FinishInterruptSafeDebug;
  138.     begin
  139.         if debug then begin
  140.             MDisposePtr(ourchars);
  141.         end;
  142.     end;
  143.  
  144.     procedure StartupInterruptSafeDebug;
  145.     begin
  146.         SetStartup(InitInterruptSafeDebug, nil, 0, FinishInterruptSafeDebug);
  147.     end;
  148.     
  149. end.